home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / LINES.I < prev    next >
Text File  |  1991-12-14  |  25KB  |  818 lines
  1. IMPLEMENTATION MODULE Lines ;
  2.  
  3. IMPORT mtAppl;
  4. IMPORT Diverses;
  5. IMPORT MagicAES ;
  6. IMPORT MagicVDI ;
  7. IMPORT MagicSys ;
  8. IMPORT MathLib0 ;
  9. IMPORT CommonData ;
  10. IMPORT HelpModule;
  11. IMPORT Undo;
  12. IMPORT Types;
  13. IMPORT Variablen;
  14.  
  15. FROM OwnBoxes IMPORT WaitForDepress, MousePos;
  16. (**
  17. IMPORT RTD;
  18. **)
  19.  
  20. TYPE  EntryTyp = RECORD
  21.                    mx , my : INTEGER ;
  22.                    m  : LONGREAL ;
  23.                  END ;
  24.  
  25.       ListTyp  = ARRAY [ 0..29 ] OF EntryTyp ;
  26.  
  27.       ArrayTyp = ARRAY [0..3] OF INTEGER;
  28.  
  29.  
  30. VAR   ArrowList , LineList : ListTyp ;
  31.       DrawMode : INTEGER;
  32.       FinalDraw : BOOLEAN;
  33.  
  34. CONST LArrow = 1 ;  LLine = 2 ;
  35.  
  36.  
  37. (*-----------------------------------------------------------------------*)
  38.  
  39.  
  40. (* Baut zwei Listen auf *)
  41.  
  42. PROCEDURE Init ( ) ;
  43.  
  44. BEGIN
  45.   WITH ArrowList [  0 ] DO  mx := 1 ; my := 0 ; m := 1.0 END ;
  46.   WITH ArrowList [  1 ] DO  mx := 4 ; my := 1 ; m := 1.0 / 4.0 END ;
  47.   WITH ArrowList [  2 ] DO  mx := 3 ; my := 1 ; m := 1.0 / 3.0 END ;
  48.   WITH ArrowList [  3 ] DO  mx := 2 ; my := 1 ; m := 1.0 / 2.0 END ;
  49.   WITH ArrowList [  4 ] DO  mx := 3 ; my := 2 ; m := 2.0 / 3.0 END ;
  50.   WITH ArrowList [  5 ] DO  mx := 4 ; my := 3 ; m := 3.0 / 4.0 END ;
  51.   WITH ArrowList [  6 ] DO  mx := 1 ; my := 1 ; m := 1.0 / 1.0 END ;
  52.   WITH ArrowList [  7 ] DO  mx := 3 ; my := 4 ; m := 4.0 / 3.0 END ;
  53.   WITH ArrowList [  8 ] DO  mx := 2 ; my := 3 ; m := 3.0 / 2.0 END ;
  54.   WITH ArrowList [  9 ] DO  mx := 1 ; my := 2 ; m := 2.0 / 1.0 END ;
  55.   WITH ArrowList [ 10 ] DO  mx := 1 ; my := 3 ; m := 3.0 / 1.0 END ;
  56.   WITH ArrowList [ 11 ] DO  mx := 1 ; my := 4 ; m := 4.0 / 1.0 END ;
  57.   WITH ArrowList [ 12 ] DO  mx := 0 ; my := 1 ; m := 1.0 END ;
  58.  
  59.   WITH LineList [  0 ] DO  mx := 1 ; my := 0 ; m := 1.0 END ;
  60.   WITH LineList [  1 ] DO  mx := 6 ; my := 1 ; m := 1.0 / 6.0 END ;
  61.   WITH LineList [  2 ] DO  mx := 5 ; my := 1 ; m := 1.0 / 5.0 END ;
  62.   WITH LineList [  3 ] DO  mx := 4 ; my := 1 ; m := 1.0 / 4.0 END ;
  63.   WITH LineList [  4 ] DO  mx := 3 ; my := 1 ; m := 1.0 / 3.0 END ;
  64.   WITH LineList [  5 ] DO  mx := 5 ; my := 2 ; m := 2.0 / 5.0 END ;
  65.   WITH LineList [  6 ] DO  mx := 2 ; my := 1 ; m := 1.0 / 2.0 END ;
  66.   WITH LineList [  7 ] DO  mx := 5 ; my := 3 ; m := 3.0 / 5.0 END ;
  67.   WITH LineList [  8 ] DO  mx := 3 ; my := 2 ; m := 2.0 / 3.0 END ;
  68.   WITH LineList [  9 ] DO  mx := 5 ; my := 4 ; m := 4.0 / 5.0 END ;
  69.   WITH LineList [ 10 ] DO  mx := 6 ; my := 5 ; m := 5.0 / 6.0 END ;
  70.   WITH LineList [ 11 ] DO  mx := 1 ; my := 1 ; m := 1.0 / 1.0 END ;
  71.   WITH LineList [ 12 ] DO  mx := 5 ; my := 6 ; m := 6.0 / 5.0 END ;
  72.   WITH LineList [ 13 ] DO  mx := 4 ; my := 5 ; m := 5.0 / 4.0 END ;
  73.   WITH LineList [ 14 ] DO  mx := 2 ; my := 3 ; m := 3.0 / 2.0 END ;
  74.   WITH LineList [ 15 ] DO  mx := 3 ; my := 5 ; m := 5.0 / 3.0 END ;
  75.   WITH LineList [ 16 ] DO  mx := 1 ; my := 2 ; m := 2.0 / 1.0 END ;
  76.   WITH LineList [ 17 ] DO  mx := 2 ; my := 5 ; m := 5.0 / 2.0 END ;
  77.   WITH LineList [ 18 ] DO  mx := 1 ; my := 3 ; m := 3.0 / 1.0 END ;
  78.   WITH LineList [ 19 ] DO  mx := 1 ; my := 4 ; m := 4.0 / 1.0 END ;
  79.   WITH LineList [ 20 ] DO  mx := 1 ; my := 5 ; m := 5.0 / 1.0 END ;
  80.   WITH LineList [ 21 ] DO  mx := 1 ; my := 6 ; m := 6.0 / 1.0 END ;
  81.   WITH LineList [ 22 ] DO  mx := 0 ; my := 1 ; m := 1.0 END ;
  82.  
  83. END Init ;
  84.  
  85.  
  86. (* Bemerkung : Die Steigungen Null und Unendlich müssen extra behandelt *)
  87. (* werden. Aus Rechengründen werden die Steigungen auf 1.0 gesetzt.     *)
  88.  
  89.  
  90. (*-----------------------------------------------------------------------*)
  91.  
  92.  
  93. PROCEDURE Real ( x : INTEGER ) : LONGREAL ;
  94.  
  95. BEGIN
  96.   RETURN MathLib0.real ( x ) ;
  97. END Real ;
  98.  
  99.  
  100. PROCEDURE Int ( r : LONGREAL ) : INTEGER ;
  101.  
  102. BEGIN
  103.   RETURN Diverses.round ( r ) ;
  104. END Int ;
  105.  
  106.  
  107. PROCEDURE Sqrt ( r : LONGREAL ) : LONGREAL ;
  108.  
  109. BEGIN
  110.   RETURN MathLib0.sqrt ( r ) ;
  111. END Sqrt ;
  112.  
  113. (*-----------------------------------------------------------------------*)
  114.  
  115.  
  116. PROCEDURE Compute ( wlist , mode : INTEGER ; VAR xy : ArrayTyp;
  117.                     VAR mx , my : INTEGER ) ;
  118.  
  119. VAR x , y , v , h , x1 , y1 , x2 , y2 , i , max : INTEGER ;
  120.     m , m1 , m2 : LONGREAL ; null , infi : BOOLEAN ; list : ListTyp ;
  121.  
  122. BEGIN
  123.  
  124.   IF wlist = LArrow THEN list := ArrowList ; max := 12  ;
  125.                     ELSE list := LineList  ; max := 22  ;
  126.   END ;
  127.  
  128.   y := xy [ 3 ] - xy [ 1 ] ;
  129.   x := xy [ 2 ] - xy [ 0 ] ;
  130.  
  131.   IF y < 0 THEN v := -1 ELSE v := +1 END ;
  132.   IF x < 0 THEN h := -1 ELSE h := +1 END ;
  133.   y := y * v ; x := x * h ;
  134.  
  135.   (* Sonderfälle *)
  136.   IF ( x * y ) = 0 THEN
  137.  
  138.     IF x = 0 THEN mx := 0 ; my := 1 * v  END ;
  139.     IF y = 0 THEN mx := 1 * h ; my := 0  END ;
  140.  
  141.   ELSE
  142.  
  143.     m := Real ( y ) / Real ( x ) ;
  144.  
  145.  
  146.     i := 1 ;
  147.     WHILE ( list [ i ].m < m  ) AND ( i < max ) DO i := i + 1 END ;
  148.  
  149.     null := FALSE ; infi := FALSE ;
  150.     IF list [ i - 1 ].my = 0 THEN null := TRUE END ;
  151.     IF list [ i     ].mx = 0 THEN infi := TRUE END ;
  152.  
  153.     m1  := list [ i - 1 ].m ;
  154.     m2  := list [ i ].m ;
  155.  
  156.     CASE mode OF
  157.  
  158.       1 :  (* x fest *)
  159.  
  160.           y1 := Int ( m1 * Real ( x ) ) ;
  161.           y2 := Int ( m2 * Real ( x ) ) ;
  162.  
  163.           IF null THEN y1 := 0  END ;
  164.           IF infi THEN y2 := y1 END ;
  165.  
  166.           IF ABS ( y - y1 ) < ABS ( y - y2 ) THEN
  167.             i := i - 1 ;
  168.             xy [ 3 ] := xy [ 1 ] + y1 * v ;
  169.           ELSE
  170.             i := i ;
  171.             xy [ 3 ] := xy [ 1 ] + y2 * v ;
  172.           END ;
  173.  
  174.         |
  175.  
  176.       2 : (* y fest *)
  177.  
  178.           x1 := Int ( 1.0 / m1 * Real ( y ) ) ;
  179.           x2 := Int ( 1.0 / m2 * Real ( y ) ) ;
  180.  
  181.           IF null THEN x1 := x2 END ;
  182.           IF infi THEN x2 := 0  END ;
  183.  
  184.           IF ABS ( x - x1 ) < ABS ( x - x2 ) THEN
  185.             i := i - 1 ;
  186.             xy [ 2 ] := xy [ 0 ] + x1 * h ;
  187.           ELSE
  188.             i := i ;
  189.             xy [ 2 ] := xy [ 0 ] + x2 * h ;
  190.           END ;
  191.  
  192.         |
  193.  
  194.       3 : (* nächster Punkt *)
  195.  
  196.           x1 := Int ( ( Real ( x ) +  m1 * Real ( y ) ) /
  197.                       ( 1.0 + m1 * m1 ) ) ;
  198.           x2 := Int ( ( Real ( x ) +  m2 * Real ( y ) ) /
  199.                       ( 1.0 + m2 * m2 ) ) ;
  200.           y1 := Int ( m1 * Real ( x1 ) ) ;
  201.           y2 := Int ( m2 * Real ( x2 ) ) ;
  202.  
  203.           IF null THEN x1 := x ; y1 := 0 END ;
  204.           IF infi THEN x2 := 0 ; y2 := y END ;
  205.  
  206.           IF Sqrt ( Real ( ( x1 - x ) * ( x1 - x ) +
  207.                            ( y1 - y ) * ( y1 - y ) ) )
  208.              <
  209.              Sqrt ( Real ( ( x2 - x ) * ( x2 - x ) +
  210.                            ( y2 - y ) * ( y2 - y ) ) )
  211.  
  212.           THEN
  213.             i := i - 1 ;
  214.             xy [ 2 ] := xy [ 0 ] + x1 * h ;
  215.             xy [ 3 ] := xy [ 1 ] + y1 * v ;
  216.           ELSE
  217.             i := i ;
  218.             xy [ 2 ] := xy [ 0 ] + x2 * h ;
  219.             xy [ 3 ] := xy [ 1 ] + y2 * v ;
  220.           END ;
  221.  
  222.     END ;
  223.  
  224.     mx := list [ i ].mx * h ;
  225.     my := list [ i ].my * v ;
  226.  
  227.   END ;
  228.  
  229. END Compute ;
  230.  
  231.  
  232. (*-----------------------------------------------------------------------*)
  233.  
  234. PROCEDURE MergeToSubpic(LastNormalObject : Types.ObjectPtrTyp);
  235. (*
  236.    Faßt alle Objekte HINTER LastNormalObject zu einem Subpicture zusammen
  237. *)
  238. VAR mycode   : Types.CodeAryTyp;
  239.     temp     : Types.ObjectPtrTyp;
  240.     i        : INTEGER;
  241.     mxx, mxy,
  242.     mnx, mny : INTEGER;
  243.     init     : BOOLEAN;
  244.     surround : ArrayTyp;
  245. BEGIN
  246. (*
  247.   PDebug.Into('Merge');
  248. *)
  249.   IF LastNormalObject<>NIL THEN
  250.     temp      := LastNormalObject^.Next;
  251.     init      := TRUE;
  252.     WHILE temp<>NIL DO
  253.       IF NOT init THEN
  254.         IF (temp^.Surround[0]< mnx ) THEN mnx  := temp^.Surround[0]; END;
  255.         IF (temp^.Surround[1]> mxy ) THEN mxy  := temp^.Surround[1]; END;
  256.         IF (temp^.Surround[0] + temp^.Surround[2]> mxx ) THEN
  257.           mxx  := temp^.Surround[0] + temp^.Surround[2];
  258.         END;
  259.         IF (temp^.Surround[1] - temp^.Surround[3]< mny ) THEN
  260.           mny  := temp^.Surround[1] - temp^.Surround[3];
  261.         END;
  262.        ELSE
  263.         init := FALSE;
  264.         mnx  := temp^.Surround[0];
  265.         mxx  := temp^.Surround[0] + temp^.Surround[2];
  266.         mny  := temp^.Surround[1] - temp^.Surround[3];
  267.         mxy  := temp^.Surround[1];
  268.       END;
  269.       temp :=